home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbtools1.arc / AEINPNUM.BAS < prev    next >
BASIC Source File  |  1987-01-12  |  4KB  |  169 lines
  1. rem $linesize:132
  2. rem $title:'Application Engineer Standard Routines'
  3. rem $subtitle:'Get numeric with range validation'
  4. '
  5. '  Input.Numeric
  6. '  Sub Routine to allow numeric input
  7. '  Uses calls to basic building block routines.
  8. '  Ver 1.0 , Dec-21-1986
  9. '
  10. '  Ver 1.1 , Jan-12-1987
  11. '  Change: If the initial value is zero, then the string should have a
  12. '          null length. Otherwise ESC has to be pressed. Silly.
  13. '
  14. '           Include the COMMON values
  15. rem $include:'AESHARED.BAS'            
  16.     
  17. sub Input.Numeric (ycoord%,xcoord%,nva#,minv#,maxv#,bdec%,decm%,help%) static
  18.  
  19. '  ycoord%  =  Y co-ordinate
  20. '  xcoord%  =  X co-ordinate
  21. '  nva#     =  numeric value
  22. '  minv#    =  minimum input value allowed
  23. '  maxv#    =  maximum input value allowed
  24. '  bdec%    =  length of input before decimals
  25. '  decm%    =  decimal places allowed
  26. '  help%    =  help text number
  27.  
  28.  
  29.  
  30.         lngth%=bdec%+decm%+abs(bdec%>0% and decm%>0%)
  31.         long.flip%=0%
  32.         vloop%=0%
  33.         im$=""
  34.  
  35.         if bdec% then
  36.             im$=string$(bdec%,"#")
  37.         end if
  38.  
  39.         if decm% then
  40.             if bdec% then
  41.                 im$=im$+"."
  42.             end if
  43.             im$=im$+string$(decm%,"#")
  44.         end if
  45.  
  46.         stg$=mid$(str$(nva#),2%)
  47.  
  48.         if nva#=0# then                           ' If value is Zero, make it a NULL
  49.             stg$=""
  50.         end if
  51.  
  52.         call decimal.check(stg$,before%,after%)
  53.  
  54.         while vloop%=0%
  55.             call decimal.check(stg$,before%,after%)
  56.             loop%=0%
  57.             prefix.d%=before%                      ' Pre decimal
  58.             postfix.d%=after%                      ' Post decimal
  59.  
  60.             while loop%=0%
  61.  
  62.                 if len(stg$)<lngth% then
  63.                     if long.flip%=1% then
  64.                         locate 25,1,0
  65.                         call clreol
  66.                         long.flip%=0%
  67.                     end if
  68.                 end if
  69.  
  70.                 call qprint (stg$+string$(lngth%-len(stg$),32),ycoord%,xcoord%)
  71.                 xd%=xcoord%+len(stg$)
  72.                 locate ycoord%,xd%,1,0,15
  73.                 call Get.Character.Type(a$,schr%,2%)
  74.                 if len(a$)=0% then                  ' ESCape - clear input line.
  75.                     stg$=""
  76.                     schr%=2%
  77.                 end if
  78.  
  79.                 if schr%=0% then
  80.                     if len(stg$)=lngth% then
  81.                         if long.flip%=0% then
  82.                             locate 25,1,0
  83.                             call clreol
  84.                             beep
  85.                             es$="Warning 1, maximum of"+str$(lngth%)+" characters already reached."
  86.                             call qprint(es$,25%,1%)
  87.                             long.flip%=1%
  88.                         end if
  89.                     end if
  90.  
  91.                     if len(stg$)<lngth% then
  92.                         if a$="." then
  93.                             if decm% then
  94.                                 if prefix.d%=len(stg$) then
  95.                                     stg$=stg$+a$
  96.                                 end if
  97.                             end if
  98.                         end if
  99.  
  100.                         if a$<>"." then
  101.                             if postfix.d%=0% then
  102.                                 stg$=stg$+a$
  103.                                 a$=""
  104.                             end if
  105.                             if postfix.d%<>0% then
  106.                                 if postfix.d%<decm% then
  107.                                     stg$=stg$+a$
  108.                                     a$=""
  109.                                 end if
  110.                             end if
  111.                             if prefix.d%<>0% then
  112.                                 if postfix.d%=0% then
  113.                                     if prefix.d%<bdec% then
  114.                                         stg$=stg$+a$
  115.                                         a$=""
  116.                                     end if
  117.                                 end if
  118.                             end if
  119.                         end if
  120.  
  121.  
  122.                     end if
  123.                 end if
  124.  
  125.                 if schr%=1% then
  126.  
  127.                     chk%=asc(a$)
  128.                     if chk%=6% then
  129.                         if len(stg$) then
  130.                             if len(stg$)=1 then
  131.                                 stg$=""
  132.                                 postfix.d%=0%
  133.                                 prefix.d%=0%
  134.                             end if
  135.                             if len(stg$) then
  136.                                 stg$=mid$(stg$,1,len(stg$)-1)
  137.                             end if
  138.                         end if
  139.                     end if
  140.                     if chk%=0% then
  141.                         loop%=1%
  142.                     end if
  143.                 end if
  144.  
  145.                 call decimal.check(stg$,prefix.d%,postfix.d%)
  146.                 call zero.check(prefix.d%)
  147.                 call zero.check(postfix.d%)
  148.  
  149.  
  150.             wend
  151.  
  152.             nva#=val(stg$)
  153.             if nva#=<maxv# and nva#>=minv# then
  154.                 vloop%=1%
  155.                 locate ycoord%,xcoord%
  156.                 print using im$;nva#;
  157.             else
  158.                 locate 25,1,0
  159.                 call clreol
  160.                 em$="Warning 2, allowable ranges are = or >"+str$(minv#)+" and = or <"+str$(maxv#)
  161.                 call qprint(em$,25,1)
  162.             end if
  163.         wend
  164.  
  165.         locate 25,1,0
  166.         call clreol
  167.  
  168.     end sub
  169.